home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / examples / bitmap-br2.lsp < prev    next >
Encoding:
Lisp/Scheme  |  1991-10-05  |  6.0 KB  |  150 lines
  1. ; -*-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;
  4. ; File:         bitmap-br2.lsp
  5. ; RCS:          $Header: bitmap-br2.lsp,v 1.2 91/10/05 05:18:00 mayer Exp $
  6. ; Description:  Example program -- Browses bitmaps in /usr/include/X11/bitmaps/*
  7. ;        click on a bitmap and it becomes the root background bitmap.
  8. ; Author:       Niels Mayer, HPLabs
  9. ; Created:      Wed Mar 14 21:13:36 1990
  10. ; Modified:     Sat Oct  5 05:16:20 1991 (Niels Mayer) mayer@hplnpm
  11. ; Language:     Lisp
  12. ; Package:      N/A
  13. ; Status:       X11r5 contrib tape release
  14. ;
  15. ; WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  16. ; XLISP version 2.1, Copyright (c) 1989, by David Betz.
  17. ;
  18. ; Permission to use, copy, modify, distribute, and sell this software and its
  19. ; documentation for any purpose is hereby granted without fee, provided that
  20. ; the above copyright notice appear in all copies and that both that
  21. ; copyright notice and this permission notice appear in supporting
  22. ; documentation, and that the name of Hewlett-Packard and Niels Mayer not be
  23. ; used in advertising or publicity pertaining to distribution of the software
  24. ; without specific, written prior permission.  Hewlett-Packard and Niels Mayer
  25. ; makes no representations about the suitability of this software for any
  26. ; purpose.  It is provided "as is" without express or implied warranty.
  27. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  28.  
  29. ;;
  30. ;; create a toplevel widget that talks to the window manager.
  31. ;;
  32. (setq toplevel_w
  33.       (send TOP_LEVEL_SHELL_WIDGET_CLASS :new "bbr2"
  34.             :XMN_TITLE "Bitmap Browser Example"
  35.             :XMN_ICON_NAME "Bitmap-Br"
  36.             ))
  37. ;;
  38. ;; inside the toplevel_w create a scrolled window widget to allow viewing
  39. ;; of a window larger than the toplevel window by panning around with
  40. ;; scrollbars.
  41. ;;
  42. (setq scrl_w
  43.       (send XM_SCROLLED_WINDOW_WIDGET_CLASS :new :managed
  44.             "sc" toplevel_w
  45.             :XMN_SCROLLING_POLICY :automatic))
  46. ;;
  47. ;; Inside the scrl_w, create a "manager" widget that lays out the entries
  48. ;; in the bitmap browser (children of scrl_w) in a vertical fashion.
  49. ;;
  50. (setq rowcol_w
  51.       (send XM_ROW_COLUMN_WIDGET_CLASS :new :managed
  52.             "rc" scrl_w
  53.             :XMN_ORIENTATION     :vertical
  54.             :XMN_PACKING         :pack_tight
  55.             :XMN_ENTRY_ALIGNMENT :alignment_center
  56.             ))
  57. ;;
  58. ;; Add a callback that sends the message :xsetroot to the child widget
  59. ;; of the rowcolumn widget that was activated via mouse click.
  60. ;;
  61. (send rowcol_w :set_callback :XMN_ENTRY_CALLBACK
  62.        '(CALLBACK_ENTRY_WIDGET) ;local variable bound to the
  63.                                 ;callback-causing widget
  64.        '(
  65.          (send CALLBACK_ENTRY_WIDGET :xsetroot)
  66.          ))
  67.  
  68. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  69. ;;;
  70. ;;; make a trivial subclass of XM_PUSH_BUTTON_GADGET_CLASS
  71. ;;;
  72. (setq Niels_Pixmap_Push_Button_Class    ;name of the new subclass
  73.       (send Class :new
  74.             '(pixmap_file)              ;a new ivar for this subclass
  75.             '()                         ;no class variables for subclass
  76.             XM_PUSH_BUTTON_GADGET_CLASS ;name of the superclass
  77.       )) 
  78. ;;;
  79. ;;; override XM_TOGGLE_BUTTON_GADGET_CLASS's instance initializer (method
  80. ;;; :isnew) such that the instance variable pixmap_file is initialized
  81. ;;; and such that the created pushbutton widget displays a pixmap.
  82. ;;;
  83. (send Niels_Pixmap_Push_Button_Class :answer :isnew '(filename &rest args)
  84.       '(
  85.         (setq pixmap_file filename)
  86.         (apply 'send-super `(:isnew ,@args
  87.                                     :XMN_LABEL_TYPE :pixmap
  88.                                     :XMN_LABEL_PIXMAP ,filename))
  89.         ))
  90. ;;;
  91. ;;; add a method responding to message :xsetroot that calls the
  92. ;;; xsetroot(1) program to set background tile. the 'system' call
  93. ;;; is the unix system(3s) call, and the 'format' call is equivalent
  94. ;;; to the unix sprintf(3s) call.
  95. ;;;
  96. (send Niels_Pixmap_Push_Button_Class :answer :xsetroot '()
  97.       '(
  98.         (system (format nil "xsetroot -bitmap ~A -fg Black -bg DimGrey" 
  99.                         pixmap_file))
  100.         ))
  101.  
  102. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  103. ;;
  104. ;; This loop creates a label,bitmap-pushbutton,separator triple for each
  105. ;; bitmap file read from the directory specified in the arg to popen(3s).
  106. ;;
  107. ;; Obvisouly, this loop should become a procedure with the name of the
  108. ;; bitmap directory passed in as parameter. However, since this is example
  109. ;; code to be read by people not conversant in WINTERP-Lisp, I am going to
  110. ;; hold off on introducing proceduralization...
  111. (do* 
  112.  (;; local do-loop variables with initialize and increment expressions.
  113.  
  114.   ;; Get a list of the bitmap files in matching the pattern
  115.   ;; /usr/local/mayer/src/bitmaps/*.xbm
  116.   ;; We use the unix popen(3s) routine to read the results of ls(1), which returns
  117.   ;; to stdout a list of matching filenames in the shell created by popen(3s). 
  118.   ;; popen(3s) returns a FILE* that can be read by the XLISP primitive 'read-line'
  119.   (ls_reader_pipe
  120.    (popen "/bin/ls /usr/include/X11/bitmaps/*" :direction :input))
  121.  
  122.   (file-name
  123.    (read-line ls_reader_pipe) (read-line ls_reader_pipe))
  124.   )
  125.  
  126.  (;; do-loop termination condition and termination code
  127.   (null file-name)                      ;terminate when (read-line) ==> EOF
  128.   (pclose ls_reader_pipe)               ;close the pipe
  129.   (send toplevel_w :realize)            ;create the toplevel window and exit
  130.   )
  131.  
  132.  ;; loop body
  133.  (send XM_LABEL_GADGET_CLASS :new :managed
  134.        "filename" rowcol_w
  135.        :XMN_LABEL_TYPE :STRING
  136.        :XMN_LABEL_STRING file-name
  137.        )
  138.  (send Niels_Pixmap_Push_Button_Class :new file-name :managed
  139.        "image" rowcol_w
  140.        )
  141.  (send XM_SEPARATOR_GADGET_CLASS :new :managed
  142.        "sep" rowcol_w
  143.        :XMN_SEPARATOR_TYPE :DOUBLE_LINE
  144.        )
  145.  )
  146.  
  147. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  148. ;; end of bitmap browser example -- note that in WINTERP you don't need to
  149. ;; mess with initializing the display nor calling XtMainLoop().
  150.